perm filename SORT.F4[P,LCS] blob sn#359771 filedate 1978-06-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION I(128),X(10000),Y(10000)
C00005 ENDMK
CāŠ—;
	DIMENSION I(128),X(10000),Y(10000)
	COMMON /JNY/J,N,Y /XY/XX,YY /X/X
	IMPLICIT INTEGER (X-Z,D-E)
	CALL GETFIL('XX')
	XX=10000
	YY=0
	M=1
	N=1
1	CALL FASTIN(I,128)
	TYPE 100,I(1)
	NN=I(1)+1
	DO 2 KK=2,NN
	CALL UNPAC (I(KK),J,K,L)
	K=K+10000
	IF(L.EQ.3)K=-K
	IF(L.LE.0)GO TO 2
C SKIP IF THIS GROUP OF SEGS HAS BEEN USED  (ALSO -3)
	IF(J.NE.XX)GO TO 3
CATCHES DUPLICATES
	IF(K.EQ.YY)GO TO 2
3	X(N)=J
	Y(N)=K
	XX=J
	YY=K
CC	TYPE 100,N,J,K,L
	N=N+1
	IF(N.LE.10000)GO TO 2
	PAUSE 'PASSED ARRAY LIMIT'
	GO TO 21
2	CONTINUE
	IF(NN.EQ.128)GO TO 1
21	J=2
20	CALL GETNXT(K)
	XOLD=XX
	YOLD=YY
	DIS=10000

5	J=K+1
	CALL GETNXT(K)
	D=DIST(XOLD,YOLD,XX,YY)
50	TYPE 100,D
	IF(D.GE.DIS)GO TO 4
	TYPE 100,D,DIS
	M=J
	DIS=D
	X2=XX
	Y2=YY
4	IF(K.LT.N)GO TO 5
C NOW FOUND NEXT CLOSEST SEG GROUP
C  CALL OUTARY
	Y(M-1)=0
	X(M-1)=LAST
	IF(LAST.LT.N)GO TO 5
CALL OUTARY































100	FORMAT(4I)
	END
 
	INTEGER FUNCTION DIST(XOLD,YOLD,X,Y)
	IMPLICIT INTEGER (X-Z)
	A=IABS(XOLD-X)
	B=IABS(YOLD-Y)
	DIST=SQRT(A**2+B**2)
	END
 
	SUBROUTINE GETNXT(K)
	COMMON /JNY/J,N,Y(1) /XY/XX,YY /X/X(1)
	IMPLICIT INTEGER (X-Z)
4	IF(Y(J).NE.0)GO TO 3
	J=X(J)
	GO TO 4
3	DO 1 K=J,N-1
1	IF(Y(K))GO TO 2
C NEG VALUE = PEN UP
2	XX=X(J)
	YY=10000+Y(J)
	END